home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
secured.fr_
/
secured.fr
Wrap
Text File
|
1995-05-07
|
5KB
|
173 lines
VERSION 4.00
Begin VB.Form frmSecured
BorderStyle = 3 'Fixed Dialog
Caption = "Access Secured Database"
ClientHeight = 2148
ClientLeft = 1224
ClientTop = 1632
ClientWidth = 4692
Height = 2592
Left = 1140
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2148
ScaleWidth = 4692
Top = 1272
Width = 4860
Begin VB.CommandButton cmdLogin
Caption = "Connect to &DB"
Height = 312
Left = 2400
TabIndex = 7
Top = 1680
Width = 1212
End
Begin VB.TextBox txtUserID
BackColor = &H00FFFFFF&
Height = 285
Left = 960
TabIndex = 5
Top = 1200
Width = 3495
End
Begin VB.TextBox txtPassword
BackColor = &H00FFFFFF&
Height = 285
Left = 960
TabIndex = 3
Top = 720
Width = 3495
End
Begin VB.CommandButton cmdQuit
Caption = "&Cancel"
Height = 315
Left = 3720
TabIndex = 2
Top = 1680
Width = 735
End
Begin VB.TextBox txtName
BackColor = &H00FFFFFF&
Height = 285
Left = 960
TabIndex = 1
Top = 240
Width = 3495
End
Begin VB.Label lblDBName
Caption = "biblio1.mdb"
Height = 252
Left = 0
TabIndex = 8
Top = 1560
Visible = 0 'False
Width = 852
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "&UserID:"
Height = 252
Left = 0
TabIndex = 6
Top = 1200
Width = 852
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "&Password"
Height = 252
Left = 0
TabIndex = 4
Top = 720
Width = 852
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "&Name"
Height = 252
Left = 0
TabIndex = 0
Top = 240
Width = 852
End
End
Attribute VB_Name = "frmSecured"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdQuit_Click()
End
End Sub
'To activate security, must have a secure.ini file
'in the application directory
Private Sub cmdLogin_Click()
'Make a temporary connection to verify database
Dim secureDB As Database
Dim secureRS As Recordset
Dim response As Integer
On Error GoTo CannotOpen
Set secureDB = OpenDatabase(lblDBName.Caption, , , "UID=srumele")
Set secureRS = secureDB.OpenRecordset("All Titles")
lblDBName.Caption = "Valid"
Me.Hide
OuttaHere:
Set secureDB = Nothing
Set secureRS = Nothing
Exit Sub
CannotOpen:
response = MsgBox("Could not connect to the database. Try again?", _
vbYesNo + vbCritical, "Login Problem")
Select Case response
Case vbYes
'Let them try again
Resume OuttaHere
Case Else
'User doesn't want to try again
Set secureDB = Nothing
Set secureRS = Nothing
End
End Select
End Sub
Private Sub Form_Load()
Dim objUser As User
Dim PID As String
PID = "tempUser"
' DBEngine.IniPath = App.Path & "\secure.ini"
' 'DBEngine.DefaultUser = "Admin"
' 'DBEngine.DefaultPassword = ""
' DBEngine.DefaultUser = "JoeAdmin"
' DBEngine.DefaultPassword = "Not"
' Set objUser = DBEngine.Workspaces(0).CreateUser("Don Kiely", PID)
' objUser.Password = "PaulWalrus"
' DBEngine.Workspaces(0).Users.Append objUser
' objUser.Groups.Append objUser.CreateGroup("Users")
'DBEngine.IniPath = "d:\winword\writing\database\ole\secure.ini"
'Set objUser = Workspaces(0).CreateUser("Don Kiely", PID)
'objUser.Password = "PaulWalrus"
'Workspaces(0).Users.Append objUser
'objUser.Groups.Append objUser.CreateGroup("Users")
'Center the form
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub